perm filename PICGRA.SAI[VIS,HPM]3 blob sn#315964 filedate 1977-11-07 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	OWN REAL PXLO,PXHI,PYLO,PYHI OWN INTEGER PPIC
C00006 00003	PROCEDURE SLIT(REAL X1,Y1,X2,Y2,BRITE,THIK)
C00008 00004	IFC FALSE THENC
C00013 ENDMK
C⊗;
OWN REAL PXLO,PXHI,PYLO,PYHI; OWN INTEGER PPIC;

PROCEDURE PSCREEN(REAL XL,YL,XH,YH; REFERENCE INTEGER PC);
   BEGIN
   PXLO←XL;
   PXHI←XH;
   PYLO←YL;
   PYHI←YH;
   PPIC←LOCATION(PC);
   END;

PROCEDURE DIT(REAL X1,Y1,BRITE);
   BEGIN
   X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
   Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
   BRITE←BRITE*MEMORY[PPIC+BMAX];
   ADDIEL(MEMORY[PPIC],Y1,X1,BRITE);
   END;

PROCEDURE THIN(REAL X1,Y1,X2,Y2,BRITE);
   BEGIN
   REAL LEN,DX,DY; REAL I; INTEGER ILEN;
   X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
   Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
   X2←(MEMORY[PPIC+LNBY]-1.9)*(X2-PXLO)/(PXHI-PXLO);
   Y2←(MEMORY[PPIC+PCLN]-1.9)*(Y2-PYHI)/(PYLO-PYHI);
   BRITE←BRITE*MEMORY[PPIC+BMAX];
   DX←X2-X1; DY←Y2-Y1; DX←DX; DY←DY;
   ILEN←LEN←SQRT(DX↑2+DY↑2);
   DX←DX/LEN; DY←DY/LEN;
   FOR I←0 STEP 0.5 UNTIL LEN DO
      ADDIEL(MEMORY[PPIC],Y1+DY*I,X1+DX*I,BRITE/2);
   COMMENT  ADDIEL(MEMORY[PPIC],Y2,X2,(LEN-ILEN)*BRITE);
   END;

PROCEDURE FADE(REAL X1,Y1,X2,Y2,BRITE1,BRITE2);
   BEGIN
   REAL LEN,DX,DY; INTEGER I,ILEN;
   X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
   Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
   X2←(MEMORY[PPIC+LNBY]-1.9)*(X2-PXLO)/(PXHI-PXLO);
   Y2←(MEMORY[PPIC+PCLN]-1.9)*(Y2-PYHI)/(PYLO-PYHI);
   BRITE1←BRITE1*MEMORY[PPIC+BMAX];
   BRITE2←BRITE2*MEMORY[PPIC+BMAX];
   DX←X2-X1; DY←Y2-Y1;
   ILEN←LEN←SQRT(DX↑2+DY↑2);
   DX←DX/LEN; DY←DY/LEN;
   FOR I←0 STEP 1 UNTIL ILEN-1 DO
      ADDIEL(MEMORY[PPIC],Y1+DY*I,X1+DX*I,(BRITE2*I+BRITE1*(ILEN-I))/ILEN);
   ADDIEL(MEMORY[PPIC],Y2,X2,(LEN-ILEN)*BRITE2);
   END;

PROCEDURE BALL(REAL X1,Y1,X2,Y2,BRITE);
   BEGIN
   REAL LEN,DX,DY,XR,YR,XC,YC,T;
   X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
   Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
   X2←(MEMORY[PPIC+LNBY]-1.9)*(X2-PXLO)/(PXHI-PXLO);
   Y2←(MEMORY[PPIC+PCLN]-1.9)*(Y2-PYHI)/(PYLO-PYHI);
   BRITE←BRITE*MEMORY[PPIC+BMAX];
   XC←(X1+X2)/2;
   YC←(Y1+Y2)/2;
   XR←(X1-X2)/2;
   YR←(Y1-Y2)/2;
   T←0;
   WHILE T<2*3.14159265 DO
      BEGIN
      REAL X,Y;
      X←XR*COS(T); Y←YR*SIN(T);
      ADDIEL(MEMORY[PPIC],YC+Y,XC+X,BRITE);
      T←T+1/SQRT(X↑2+Y↑2);
      END;
   END;
PROCEDURE SLIT(REAL X1,Y1,X2,Y2,BRITE,THIK);
   BEGIN
   REAL X1A,X1B,Y1A,Y1B,X2A,X2B,Y2A,Y2B,LEN,DX,DY,XOFF,YOFF;
   REAL I; INTEGER ILEN;
   DX←X2-X1; DY←Y2-Y1;
   LEN←SQRT(DX*DX+DY*DY);
   XOFF←DY*THIK/(2*LEN);
   YOFF←-DX*THIK/(2*LEN);
   X1A←X1-XOFF;
   Y1A←Y1-YOFF;
   X1B←X1+XOFF;
   Y1B←Y1+YOFF;

   X2A←X2-XOFF;
   Y2A←Y2-YOFF;
   X2B←X2+XOFF;
   Y2B←Y2+YOFF;

   X1A←(MEMORY[PPIC+LNBY]-1.9)*(X1A-PXLO)/(PXHI-PXLO);
   Y1A←(MEMORY[PPIC+PCLN]-1.9)*(Y1A-PYHI)/(PYLO-PYHI);
   X2A←(MEMORY[PPIC+LNBY]-1.9)*(X2A-PXLO)/(PXHI-PXLO);
   Y2A←(MEMORY[PPIC+PCLN]-1.9)*(Y2A-PYHI)/(PYLO-PYHI);
   X1B←(MEMORY[PPIC+LNBY]-1.9)*(X1B-PXLO)/(PXHI-PXLO);
   Y1B←(MEMORY[PPIC+PCLN]-1.9)*(Y1B-PYHI)/(PYLO-PYHI);
   X2B←(MEMORY[PPIC+LNBY]-1.9)*(X2B-PXLO)/(PXHI-PXLO);
   Y2B←(MEMORY[PPIC+PCLN]-1.9)*(Y2B-PYHI)/(PYLO-PYHI);

   BRITE←BRITE*MEMORY[PPIC+BMAX];
   DX←X2-X1; DY←Y2-Y1;
   ILEN←LEN←SQRT(DX↑2+DY↑2);
   DX←DX/LEN; DY←DY/LEN;






   END;
IFC FALSE THENC
PROCEDURE PIXLIN(REAL X1,Y1,X2,Y2,BR;
                 REFERENCE INTEGER PIC;
                 REAL XLO(0),YLO(0),XHI(1),YHI(1));
   BEGIN
   SAFE REAL ARRAY WT[-1:1,-1:1];
   REAL LEN,DX,DY,DTX,DTY,TX,TY,T,CON; INTEGER IX,IY,IDX,IDY;
   X1←MEMORY[LOCATION(PIC)+LNBY]*(X1-XLO)/(XHI-XLO);
   X2←MEMORY[LOCATION(PIC)+LNBY]*(X2-XLO)/(XHI-XLO);
   Y1←MEMORY[LOCATION(PIC)+PCLN]*(Y1-YLO)/(YHI-YLO);
   Y2←MEMORY[LOCATION(PIC)+PCLN]*(Y2-YLO)/(YHI-YLO);
   DX←X2-X1; DY←Y2-Y1;
   IDX←IF DX>0 THEN 1 ELSE -1;
   IDY←IF DY>0 THEN 1 ELSE -1;
   LEN←SQRT(DX↑2+DY↑2);
   DTX←ABS(LEN/(X2-X1));  DTY←ABS(LEN/(Y2-Y1));
   IX←X1; IY←Y1;
   TX←(X1-IX)/DX; IF TX<0 THEN TX←(X1-IX-1)/DX;
   TX←TX*SQRT(1+DY↑2);
   TY←(Y1-IY)/DY; IF TY<0 THEN TY←(Y1-IY-1)/DY;
   TY←TY*SQRT(1+DX↑2);
   T←0;
   BR←BR*MEMORY[LOCATION(PIC)+BMAX]/SQRT(2);
   CON←X1*Y2-X2*Y1;
   OUTSTR("BR "&CVF(BR)&"  TX "&CVF(TX)&"  TY "&CVF(TY)&"  DTX "&CVF(DTX)&"  DTY "&CVF(DTY)&'15&'12);
   WHILE T<LEN DO IF TX+DTX<TY+DTY THEN
      BEGIN
      INTEGER II,JJ; REAL VAL;
      TX←(TX+DTX) MIN LEN;
      VAL←0;
      FOR II←-1,0,1 DO
      FOR JJ←-1,0,1 DO
         BEGIN
         WT[II,JJ]←(LEN-ABS((II+IY)*DX-(JJ+IX)*DY+CON)) MAX 0;
         VAL←VAL+WT[II,JJ];
         END;
      FOR II←-1,0,1 DO
      FOR JJ←-1,0,1 DO
         ADDEL(PIC,II+IY,JJ+IX,BR*(TX-T)*WT[II,JJ]/VAL);
      T←TX;
      IX←IX+IDX;
      END
   ELSE
      BEGIN
      INTEGER II,JJ; REAL VAL;
      TY←(TY+DTY) MIN LEN;
      VAL←0;
      FOR II←-1,0,1 DO
      FOR JJ←-1,0,1 DO
         BEGIN
         WT[II,JJ]←(LEN-ABS((II+IY)*DX-(JJ+IX)*DY+CON)) MAX 0;
         VAL←VAL+WT[II,JJ];
         END;
      FOR II←-1,0,1 DO
      FOR JJ←-1,0,1 DO
         ADDEL(PIC,II+IY,JJ+IX,BR*(TX-T)*WT[II,JJ]/VAL);
      T←TY;
      IY←IY+IDY;
      END;
   END;

PROCEDURE PICLIN(REAL X1,Y1,X2,Y2,BR;
                 REFERENCE INTEGER PIC;
                 REAL XLO(0),YLO(0),XHI(1),YHI(1));
   BEGIN
   REAL LEN,DX,DY,DTX,DTY,TX,TY,T; INTEGER IX,IY,IDX,IDY;
   X1←MEMORY[LOCATION(PIC)+LNBY]*(X1-XLO)/(XHI-XLO);
   X2←MEMORY[LOCATION(PIC)+LNBY]*(X2-XLO)/(XHI-XLO);
   Y1←MEMORY[LOCATION(PIC)+PCLN]*(Y1-YLO)/(YHI-YLO);
   Y2←MEMORY[LOCATION(PIC)+PCLN]*(Y2-YLO)/(YHI-YLO);
   DX←X2-X1; DY←Y2-Y1;
   IDX←IF DX>0 THEN 1 ELSE -1;
   IDY←IF DY>0 THEN 1 ELSE -1;
   LEN←SQRT(DX↑2+DY↑2);
   DTX←ABS(LEN/(X2-X1));  DTY←ABS(LEN/(Y2-Y1));
   IX←X1; IY←Y1;
   TX←(X1-IX)/DX; IF TX<0 THEN TX←(X1-IX-1)/DX;
   TX←TX*SQRT(1+DY↑2);
   TY←(Y1-IY)/DY; IF TY<0 THEN TY←(Y1-IY-1)/DY;
   TY←TY*SQRT(1+DX↑2);
   T←0;
   BR←BR*MEMORY[LOCATION(PIC)+BMAX]/SQRT(2);
   OUTSTR("BR "&CVF(BR)&"  TX "&CVF(TX)&"  TY "&CVF(TY)&"  DTX "&CVF(DTX)&"  DTY "&CVF(DTY)&'15&'12);
   WHILE T<LEN DO IF TX+DTX<TY+DTY THEN
      BEGIN
      TX←(TX+DTX) MIN LEN;
      ADDEL(PIC,IY,IX,(TX-T)*BR);
      T←TX;
      IX←IX+IDX;
      END
   ELSE
      BEGIN
      TY←(TY+DTY) MIN LEN;
      ADDEL(PIC,IY,IX,(TY-T)*BR);
      T←TY;
      IY←IY+IDY;
      END;
   END;
ENDC